SuperHack/SuperHack CD.bin/CODING/DELPHI/SOUNDEX.ZIP/SOUNDEX.PAS

Pascal/Delphi Source File | 1996-02-06 | 10.7 KB | 326 lines

{ ****************************************************************** }
{                                                                    }
{   Delphi component TSoundex                                        }
{                                                                    }
{   Copyright ⌐ 1995 by Indigo Software                              }
{                                                                    }
{ ****************************************************************** }

(*---------------------------------------------------------------------|
Description:
The Soundex component uses the Soundex algorithm to determine if two
words sound similar.  Useful in database applications where the
operator may not know the exact spelling of a search string, for
example a last name.

Properties:

FirstWord/SecondWord: String
      The FirstWord and SecondWord properties define the two words that
      are to be compared.  The SoundAlike and SoundAlikePlus properties
      will state whether the words sound similar, depending on which
      method you choose.

SoundexValue: String
      The SoundexValue property is a string consisting of a series of
      numbers that depicts the unique sound of the word specified in
      the FirstWord property.

      This value can be stored in a hidden field of a database for
      future searches.  When the operator searches for a given string
      (for example, a last name), it can be converted to a SoundexValue,
      and compared to the values in the hidden field, thereby returning
      all records which match the sound of the search string.

SoundAlike: Boolean
      The SoundAlike property states whether the words defined by
      FirstWord and SecondWord sound similar according to the Soundex
      algorithm.

SoundexPlusValue: String
      The SoundexPlusValue property is a string consisting of a series
      of numbers that depicts the unique sound of the word specified in
      the FirstWord property.

      This value can be stored in a hidden field of a database for future
      searches.  When the operator searches for a given string
      (for example, a last name), it can be converted to a SoundexPlusValue,
      and compared to the values in the hidden field, thereby returning all
      records which match the sound of the search string.

      In the Soundex algorithm, words that begin with different letters do
      not sound similar.  Therefore, the words phish and fish, or sell and
      cell, would return different SoundexValues.  Because of this, a new
      algorithm, SoundexPlus, was developed.  This algorithm takes the first
      letter into consideration, and in the above examples, returns true.

SoundAlikePlus: Boolean
      The SoundAlikePlus property states whether the words defined by
      FirstWord and SecondWord sound similar according to the SoundexPlus
      algorithm.

Methods:

Soundex(CheckWord:string):string;
      The Soundex method is a function which returns the SoundexValue
      for the CheckWord.

SoundexPlus(CheckWord:string):string;
      The SoundexPlus method is a function which returns the
      SoundexPlusValue for the CheckWord.
|---------------------------------------------------------------------*)
unit Soundex;

interface

{$IFDEF WIN32}
uses Messages, Windows, SysUtils, Classes, Controls,
     Forms, Menus, Graphics;
{$ELSE}
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Menus, Graphics;
{$ENDIF}


type
  TSoundex = class(TComponent)
    private
      { Private fields of TSoundex }
        { Storage for property FirstWord }
        FFirstWord : String;
        { Storage for property SecondWord }
        FSecondWord : String;
        { Storage for property SoundexValue }
        FSoundexValue : String;
        { Storage for property SoundAlike }
        FSoundAlike : Boolean;
        { Storage for property SoundexPlusValue }
        FSoundexPlusValue : String;
        { Storage for property SoundAlikePlus }
        FSoundAlikePlus : Boolean;

      { Private methods of TSoundex }
        { Method to set variable and property values and create objects }
        procedure AutoInitialize;
        { Method to free any objects created by AutoInitialize }
        procedure AutoDestroy;
        { Read method for property SoundexValue }
        function GetSoundexValue : String;
        { Write method for property SoundexValue }
        procedure SetSoundexValue(Value : String);
        { Read method for property SoundAlike }
        function GetSoundAlike : Boolean;
        { Write method for property SoundAlike }
        procedure SetSoundAlike(Value : Boolean);
        { Read method for property SoundexPlusValue }
        function GetSoundexPlusValue : String;
        { Write method for property SoundexPlusValue }
        procedure SetSoundexPlusValue(Value : String);
        { Read method for property SoundAlikePlus }
        function GetSoundAlikePlus : Boolean;
        { Write method for property SoundAlikePlus }
        procedure SetSoundAlikePlus(Value : Boolean);

    protected
      { Protected fields of TSoundex }

      { Protected methods of TSoundex }

    public
      { Public fields of TSoundex }

      { Public methods of TSoundex }
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        function Soundex(OriginalWord:string):string;
        function SoundexPlus(OriginalWord:string):string;

    published
      { Published properties of the component }
        property FirstWord : String read FFirstWord write FFirstWord;
        property SecondWord : String read FSecondWord write FSecondWord;
        property SoundexValue : String
             read GetSoundexValue write SetSoundexValue;
        property SoundAlike : Boolean
             read GetSoundAlike write SetSoundAlike
             default false;
        property SoundexPlusValue : String
             read GetSoundexPlusValue write SetSoundexPlusValue;
        property SoundAlikePlus : Boolean
             read GetSoundAlikePlus write SetSoundAlikePlus;

  end;

procedure Register;

implementation

procedure Register;
begin
     { Register TSoundex with Indigo Widgets as its
       default page on the Delphi component palette }
     RegisterComponents('Indigo Widgets', [TSoundex]);
end;

{ Method to set variable and property values and create objects }
procedure TSoundex.AutoInitialize;
begin
     FSoundAlike := false;
end; { of AutoInitialize }

{ Method to free any objects created by AutoInitialize }
procedure TSoundex.AutoDestroy;
begin
     { No objects from AutoInitialize to free }
end; { of AutoDestroy }

{ Read method for property SoundexValue }
function TSoundex.GetSoundexValue : String;
begin
   fsoundexvalue:=soundex(firstword);
   getsoundexvalue:=fsoundexvalue;
end;

{ Write method for property SoundexValue }
procedure TSoundex.SetSoundexValue(Value : String);
begin
     FSoundexValue := fsoundexvalue;
end;

{ Read method for property SoundAlike }
function TSoundex.GetSoundAlike : Boolean;
begin
  if (Soundex(firstword)=Soundex(secondword)) then
    FSoundAlike:=True
  else
    FSoundAlike:=False;
     GetSoundAlike := FSoundAlike;
end;

{ Write method for property SoundAlike }
procedure TSoundex.SetSoundAlike(Value : Boolean);
begin
     FSoundAlike := FSoundAlike;
end;

{ Read method for property SoundexPlusValue }
function TSoundex.GetSoundexPlusValue : String;
begin
     fsoundexplusvalue:=soundexplus(firstword);
     GetSoundexPlusValue := FSoundexPlusValue
end;

{ Write method for property SoundexPlusValue }
procedure TSoundex.SetSoundexPlusValue(Value : String);
begin
     FSoundexPlusValue := FSoundexPlusValue;
end;

{ Read method for property SoundAlikePlus }
function TSoundex.GetSoundAlikePlus : Boolean;
begin
  if (Soundexplus(firstword)=Soundexplus(secondword)) then
    FSoundAlikeplus:=True
  else
    FSoundAlikeplus:=False;
     GetSoundAlikePlus := FSoundAlikePlus;
end;

{ Write method for property SoundAlikePlus }
procedure TSoundex.SetSoundAlikePlus(Value : Boolean);
begin
     FSoundAlikePlus := FSoundAlikePlus;
end;

constructor TSoundex.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     AutoInitialize;
end;

destructor TSoundex.Destroy;
begin
     AutoDestroy;
     inherited Destroy;
end;

function TSoundex.Soundex(OriginalWord:string):string;
var
  Tempstring1,Tempstring2:string;
  Count:integer;
begin
  Tempstring1:='';
  Tempstring2:='';
  OriginalWord:=Uppercase(OriginalWord); {Make original word uppercase}
  Appendstr(Tempstring1,OriginalWord[1]); {Use the first letter of the word}
  for Count:=2 to length(OriginalWord) do
      {Assign a numeric value to each letter, except the first}
      case OriginalWord[Count] of
        'B','F','P','V':
          Appendstr(Tempstring1,'1');
        'C','G','J','K','Q','S','X','Z':
          Appendstr(Tempstring1,'2');
        'D','T':
          Appendstr(Tempstring1,'3');
        'L':
          Appendstr(Tempstring1,'4');
        'M','N':
          Appendstr(Tempstring1,'5');
        'R':
          Appendstr(Tempstring1,'6');
        {All other letters, punctuation and numbers are ignored}
      end;

  Appendstr(Tempstring2,OriginalWord[1]);

  {Go through the result, and remove any consecutive numberic values
   that are duplicates}
  for Count:=2 to length(Tempstring1) do
    if Tempstring1[Count-1]<>Tempstring1[Count] then
        Appendstr(Tempstring2,Tempstring1[Count]);

  Soundex:=Tempstring2; {This is the soundex value}

end;

function TSoundex.SoundexPlus(OriginalWord:string):string;
var
  Tempstring1,Tempstring2:string;
  Count:integer;
begin
  Tempstring1:='';
  Tempstring2:='';
  OriginalWord:=Uppercase(OriginalWord); {Make original word uppercase}

  for Count:=1 to length(OriginalWord) do
      {Assign a numeric value to each letter}
      case OriginalWord[Count] of
        'B','F','P','V':
          Appendstr(Tempstring1,'1');
        'C','G','J','K','Q','S','X','Z':
          Appendstr(Tempstring1,'2');
        'D','T':
          Appendstr(Tempstring1,'3');
        'L':
          Appendstr(Tempstring1,'4');
        'M','N':
          Appendstr(Tempstring1,'5');
        'R':
          Appendstr(Tempstring1,'6');
        {All other letters, punctuation and numbers are ignored}
      end;

  {Go through the result, and remove any consecutive numberic values
   that are duplicates}
  for Count:=1 to length(Tempstring1) do
    if Tempstring1[Count-1]<>Tempstring1[Count] then
        Appendstr(Tempstring2,Tempstring1[Count]);

  Soundexplus:=Tempstring2; {This is the soundexplus value}

end;



end.